home *** CD-ROM | disk | FTP | other *** search
Wrap
VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Object = "{B826C06B-C37C-4A6C-BEB8-53B5CEF374C9}#1.0#0"; "CDRProX.dll" Begin VB.Form frmMain BorderStyle = 1 'Fixed Single Caption = "CDWriterPro Sample1" ClientHeight = 7620 ClientLeft = 150 ClientTop = 435 ClientWidth = 8685 Icon = "frmMain.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 7620 ScaleWidth = 8685 StartUpPosition = 1 'CenterOwner Begin VB.Frame fraWriteOptions Caption = "Write Options" Height = 1560 Left = 4185 TabIndex = 16 Top = 5145 Width = 4395 Begin VB.CheckBox chkTestWrite Caption = "Test Write" Height = 315 Left = 105 TabIndex = 20 Top = 825 Width = 4170 End Begin VB.CheckBox chkFinalizeDisc Caption = "Finalize Disc (No Further Writing Possible)" Height = 315 Left = 105 TabIndex = 19 Top = 570 Width = 3840 End Begin VB.CheckBox chkCacheImage Caption = "Cache Image Before Writing." Height = 315 Left = 105 TabIndex = 18 Top = 300 Width = 4185 End Begin VB.CheckBox chkUseBurnProof Caption = "Use Buffer Protection (Burn Proof,JustLink,etc.)" Height = 315 Left = 105 TabIndex = 17 Top = 1110 Width = 4170 End End Begin VB.Frame fraImageOptions Caption = "Data Options" Height = 1560 Left = 15 TabIndex = 13 Top = 5145 Width = 4050 Begin VB.CheckBox chkUseMode2XA Caption = "Mode2XA instead of Mode1 (CDR/W Only)" Height = 195 Left = 165 TabIndex = 22 ToolTipText = "Please see help file for details on Mode2XA" Top = 945 Width = 3555 End Begin VB.CheckBox chkUseJoliet Caption = "Include Joliet Directories (64 char file names)" Height = 195 Left = 165 TabIndex = 21 Top = 645 Value = 1 'Checked Width = 3555 End Begin VB.TextBox txtVolIdentifier Height = 300 Left = 1005 MaxLength = 32 TabIndex = 14 Text = "New Disc" Top = 270 Width = 2580 End Begin VB.Label lblVolIdentifier Caption = "Volume ID:" Height = 255 Left = 120 TabIndex = 15 Top = 330 Width = 855 End End Begin VB.PictureBox picSplitter BackColor = &H00808080& BorderStyle = 0 'None FillColor = &H00808080& Height = 4335 Left = 3465 ScaleHeight = 1887.645 ScaleMode = 0 'User ScaleWidth = 1248 TabIndex = 9 Top = 750 Visible = 0 'False Width = 120 End Begin MSComDlg.CommonDialog CommonDialog1 Left = 7155 Top = 0 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End Begin VB.CommandButton cmdCancel Caption = "&Cancel" Height = 375 Left = 1665 TabIndex = 8 Top = 6833 Width = 1500 End Begin VB.CommandButton cmdWriteDisc Caption = "&Write Disc" Height = 375 Left = 90 TabIndex = 7 Top = 6833 Width = 1500 End Begin MSComctlLib.StatusBar sbrStatus Align = 2 'Align Bottom Height = 345 Left = 0 TabIndex = 6 Top = 7275 Width = 8685 _ExtentX = 15319 _ExtentY = 609 SimpleText = "Add Audio Files" _Version = 393216 BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} NumPanels = 3 BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} AutoSize = 1 Object.Width = 8784 EndProperty BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} Object.Width = 3881 MinWidth = 3881 EndProperty BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} EndProperty EndProperty End Begin VB.ComboBox cboDevices Height = 315 Left = 525 Style = 2 'Dropdown List TabIndex = 2 Top = 90 Width = 2835 End Begin VB.ComboBox cboWriteSpeed Height = 315 Left = 4530 Style = 2 'Dropdown List TabIndex = 0 Top = 75 Width = 1095 End Begin MSComctlLib.ProgressBar prgTotalProgress Height = 300 Left = 4185 TabIndex = 4 Top = 6870 Width = 4395 _ExtentX = 7752 _ExtentY = 529 _Version = 393216 Appearance = 1 Scrolling = 1 End Begin MSComctlLib.ImageList ImageList1 Left = 7710 Top = -15 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 16 ImageHeight = 16 MaskColor = 12632256 _Version = 393216 BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} NumListImages = 4 BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":0442 Key = "CLOSEDFOLDER" EndProperty BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":0894 Key = "CD" EndProperty BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":0CE6 Key = "OPENFOLDER" EndProperty BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":1138 Key = "FILE" EndProperty EndProperty End Begin MSComctlLib.ListView lvwImageFiles Height = 4335 Left = 3630 TabIndex = 10 Top = 765 Width = 4950 _ExtentX = 8731 _ExtentY = 7646 View = 3 LabelEdit = 1 Sorted = -1 'True LabelWrap = -1 'True HideSelection = -1 'True OLEDragMode = 1 OLEDropMode = 1 _Version = 393217 Icons = "ImageList1" SmallIcons = "ImageList1" ForeColor = -2147483640 BackColor = -2147483643 BorderStyle = 1 Appearance = 1 OLEDragMode = 1 OLEDropMode = 1 NumItems = 3 BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} Text = "File Name" Object.Width = 4410 EndProperty BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} Alignment = 1 SubItemIndex = 1 Text = "Size" Object.Width = 2540 EndProperty BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} SubItemIndex = 2 Text = "Date" Object.Width = 3881 EndProperty End Begin MSComctlLib.TreeView tvwDirectories DragIcon = "frmMain.frx":158A Height = 4335 Left = 60 TabIndex = 11 Top = 750 Width = 3195 _ExtentX = 5636 _ExtentY = 7646 _Version = 393217 Indentation = 353 LabelEdit = 1 Sorted = -1 'True Style = 7 Appearance = 1 OLEDragMode = 1 OLEDropMode = 1 End Begin CDRPROXLibCtl.CDWriterPro CDWriterPro1 Left = 6000 OleObjectBlob = "frmMain.frx":19CC Top = 135 End Begin VB.Line Line1 BorderColor = &H00000000& X1 = 30 X2 = 8670 Y1 = 0 Y2 = 0 End Begin VB.Label lblImageFileTitle BorderStyle = 1 'Fixed Single Caption = "Image Files - Drag and Drop Files or Folders" Height = 270 Left = 45 TabIndex = 12 Top = 450 Width = 8535 End Begin VB.Image imgSplitter Height = 4335 Left = 3300 MousePointer = 9 'Size W E Top = 750 Width = 90 End Begin VB.Label lblTotalWritten Caption = "Written:" Height = 285 Left = 3570 TabIndex = 5 Top = 6878 Width = 645 End Begin VB.Label lblRecorder Alignment = 1 'Right Justify Caption = "Drive:" Height = 225 Left = -225 TabIndex = 3 Top = 120 Width = 720 End Begin VB.Label lblWriteSpeed Alignment = 1 'Right Justify Caption = "Write Speed" Height = 255 Left = 3495 TabIndex = 1 Top = 135 Width = 975 End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuFileClear Caption = "Clear All Items" Shortcut = ^C End Begin VB.Menu mnuFileSep1 Caption = "-" End Begin VB.Menu mnuFileRemoveDir Caption = "Remove Directory" End Begin VB.Menu mnuFileRenameDir Caption = "Rename Directory" End Begin VB.Menu mnuFileRemoveFile Caption = "Remove File" End Begin VB.Menu mnuFileRenameFile Caption = "Rename File" End Begin VB.Menu mnuFileSep2 Caption = "-" End Begin VB.Menu mnuFileSaveImageAsISO Caption = "&Save Image as ISO File..." End Begin VB.Menu mnuFileWriteDiscFromISO Caption = "&Write Disc from ISO File..." End Begin VB.Menu mnuFileSep3 Caption = "-" End Begin VB.Menu mnuFileExit Caption = "Exit" Shortcut = ^X End End Begin VB.Menu mnuCDRecorder Caption = "&CD-Recorder" Begin VB.Menu mnuCDRecorderEject Caption = "Eject" Shortcut = ^J End Begin VB.Menu mnuCDRecorderCloseTray Caption = "Close Tray" Shortcut = ^T End Begin VB.Menu mnuCDRecorderDiscInfo Caption = "Disc Information..." End Begin VB.Menu mnuCDRecorderEraseDisc Caption = "Erase Disc..." End Begin VB.Menu mnuCDRecorderImportPreviousSession Caption = "Import Previous Session" End End Begin VB.Menu mnuHelp Caption = "&Help" Begin VB.Menu mnuHelpAbout Caption = "About" End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private mlngCurrentDrive As Long Private mblnUnloadOk As Boolean Private mblnMoving As Boolean Private Const sglSplitLimit As Single = 500 '**************************************************************** '**************************************************************** 'COPYRIGHT 2003 NUMEDIA SOFT,INC. 'This is a sample of how you could use the CDWriterPro control. 'There are improvements which could be made rather easily. 'Feel free to modify it as you see fit. 'This Sample Shows how to write a data CDR/W (ISO/Joliet) Private Sub CDWriterPro1_EnumISOItems(ByVal sParentDestPath As String, ByVal sItemDestPath As String, ByVal sItemName As String, ByVal sSourceFilePath As String, ByVal bIsDirectory As Boolean, ByVal dteFileDate As Date, ByVal lFileSize As Long) Dim lstItem As ListItem 'If a file get some file attributes and add to the list. 'We wont add directories to the list view in this sample... 'It will suffice to have directories in the TreeView only! If bIsDirectory = False Then 'Add to the list Set lstItem = lvwImageFiles.ListItems.Add(, sItemDestPath, sItemName, "FILE", "FILE") lstItem.SubItems(1) = Format(lFileSize / 1000, "###,###,##0.00") & " KB" lstItem.SubItems(2) = Format(dteFileDate, "MM/DD/YYYY hh:mm:ss AMPM") End If End Sub Private Sub CDWriterPro1_ISODestPathChanged(ByVal sOldDestPath As String, ByVal sNewDestPath As String, ByVal bIsDirectory As Boolean) 'When a Path has changed (via renaming a directory or file), its 'Destination path is modified to reflect the new image tree. 'this event allows you to update image items with thier new destination 'paths. Since the paths are used as the keys for our tree and list, these need 'to be updated. We will change directory keys, and reload the file list. If bIsDirectory = True Then 'Update the directory's key after the renaming tvwDirectories.Nodes(sOldDestPath).Key = sNewDestPath End If End Sub Private Sub CDWriterPro1_ISOImageReset() 'Call reset routine Call ResetImage End Sub Private Sub CDWriterPro1_ISOItemAdded(ByVal sParentDestPath As String, ByVal sItemDestPath As String, ByVal sItemName As String, ByVal SourceFilePath As String, ByVal bIsDirectory As Boolean, ByVal dteFileDate As Date, ByVal lFileSize As Long) 'We are going to add directories to the tree 'We don't need to worry about files because they 'are handled by the EnumerateISOItems method as a particular 'directory is selected. If bIsDirectory = True Then Call tvwDirectories.Nodes.Add(sParentDestPath, tvwChild, sItemDestPath, sItemName, "CLOSEDFOLDER", "OPENFOLDER") sbrStatus.Panels(1).Text = "Adding...." & sItemDestPath End If 'Give the GUI a chance to process events DoEvents End Sub Private Sub CDWriterPro1_ISOItemRemoved(ByVal sDestinationPath As String, ByVal sItemName As String, ByVal bIsDirectory As Boolean) If bIsDirectory = True Then 'Remove the node from the tree...all child nodes are also deleted Call tvwDirectories.Nodes.Remove(sDestinationPath) End If End Sub Private Sub CDWriterPro1_ISOItemRenamed(ByVal sOldDestPath As String, ByVal sNewDestPath As String, ByVal sNewItemName As String, ByVal bIsDirectory As Boolean) 'We don't need this event in this sample because the Tree/list controls handle 'updating the new item names after renaming is complete. End Sub Private Sub CDWriterPro1_ReadingTrackFile(ByVal sFileName As String, ByVal lFileIndex As Long, ByVal lTrackNumber As Long) sbrStatus.Panels(1).Text = "Track: " & Format(lTrackNumber, "0#") & " - Reading..." & CStr(lFileIndex) & " - " & sFileName End Sub Private Sub CDWriterPro1_ReadingTrackFileError(ByVal TrackFileError As CDRPROXLibCtl.eTrackFileError, ByVal sFileName As String, ByVal lTrackNumber As Long) Dim strErrorMsg As String 'Get the error message from public function in module 'Globals' strErrorMsg = GetTrackFileErrorMessage(TrackFileError, sFileName) 'Show error message in the status bar...an error will also be raised as a write error sbrStatus.Panels(1).Text = "ERROR:" & sFileName Debug.Print "FileError - " & sFileName & CStr(TrackFileError), CStr(lTrackNumber) End Sub Private Sub CDWriterPro1_ReplaceImportedISOFile(ByVal sDestPath As String, ByVal sNewSourcePath As String, ByVal sFileName As String, bReplaceFile As Boolean) Dim lngResult As Long 'Should we replcae the imported file lngResult = MsgBox("Imported file from the last session on this disc: " & vbCrLf & sDestPath & vbCrLf & _ "Would you like to replace it with: " & vbCrLf & sNewSourcePath & " ?", vbOKCancel + vbQuestion, "Replace imported file...") 'Set the replacement flag by reference If lngResult = vbOK Then bReplaceFile = True Else bReplaceFile = False End If End Sub Private Sub CDWriterPro1_PreparingToWrite() 'Display status sbrStatus.Panels(1).Text = "Preparing to Write...." prgTotalProgress.Value = 0 'Disable buttons as we start to write Call EnableForm(False) End Sub Private Sub CDWriterPro1_CreatingDirectories() sbrStatus.Panels(1).Text = "Creating Directories...." End Sub Private Sub CDWriterPro1_ClosingDisc() sbrStatus.Panels(1).Text = "Closing Disc...." End Sub Private Sub CDWriterPro1_ClosingSession() sbrStatus.Panels(1).Text = "Closing Session...." End Sub Private Sub CDWriterPro1_ClosingTrack(ByVal lTrackNumber As Long) sbrStatus.Panels(1).Text = "Closing Track...." End Sub Private Sub CDWriterPro1_CachingStatus(ByVal nPercentComplete As Integer) 'Show the progress of caching the ISO/Joliet image sbrStatus.Panels(2).Text = "Caching - " & Format(nPercentComplete, "0#") & " %" End Sub Private Sub CDWriterPro1_TrackWriteStatus(ByVal lTrackNumber As Long, ByVal lBlocksWritten As Long, ByVal lBlocksToWrite As Long) Dim intPercentTrackWritten As Integer On Error Resume Next 'Calc Percent of Current track done intPercentTrackWritten = ((lBlocksWritten / lBlocksToWrite) * 100) 'Set Progress Bars prgTotalProgress.Value = intPercentTrackWritten End Sub Private Sub CDWriterPro1_WriteCancelled() 'Inform user of cancelled write sbrStatus.Panels(1).Text = "Writing Cancelled......" Call EnableForm(True) 'Completed Message MsgBox "Writing Cancelled!", vbInformation + vbOKOnly, App.Title End Sub Private Sub CDWriterPro1_WriteComplete() 'Inform user of writing complete sbrStatus.Panels(1).Text = "Writing Complete!" 'Enable the form Call EnableForm(True) 'Completed Message MsgBox "Writing is complete!", vbInformation + vbOKOnly, App.Title 'If not in test mode..eject If CDWriterPro1.TestWrite = False Then 'Eject disc Call CDWriterPro1.EjectLoad(False) End If End Sub Private Sub CDWriterPro1_WriteError(ByVal WriteError As CDRPROXLibCtl.eWriteErrorType, ByVal DriveError As CDRPROXLibCtl.eCDError, ByVal sErrorInfo As String, ByVal sSenseInfo As String) Dim strError As String 'Get the error type and strError = "Writing Error: (" & CStr(WriteError) & ") " & sErrorInfo & vbCrLf 'If it is a drive error, add the drive error information 'to the displayed message If WriteError = errDriveError Then strError = strError & GetDriveErrorMessage(DriveError) & vbCrLf & " Error Sense Data: " & sSenseInfo End If 'Display Msg to user MsgBox strError, vbCritical + vbOKOnly Call EnableForm(True) End Sub Private Sub cmdCancel_Click() 'Cancel recording sbrStatus.Panels(1).Text = "Aborting Write...Please Wait!" CDWriterPro1.CancelWrite End Sub Private Sub cmdWriteDisc_Click() 'Check for a valid Drive If mlngCurrentDrive = -1 Then MsgBox "A drive is not selected or does not exist.", vbInformation + vbOKOnly, App.Title Exit Sub End If 'Check for media loaded If CDWriterPro1.GetMediaType() = mtNotLoaded Then MsgBox "Please Insert Writable Media before continuing!", vbInformation, App.Title Exit Sub End If 'Set the properties of the write With CDWriterPro1 .CloseDisc = (chkFinalizeDisc.Value = vbChecked) 'Finalize 'Always Close session .CloseSession = True 'Also write Joliet Directory structures in addition to ISO structures .VolumeType = IIf((chkUseJoliet.Value = vbChecked), vtyISO9660_JOLIET, vtyISO9660_ONLY) .VolumeIdentifier = txtVolIdentifier.Text 'Were setting only the Volume Identifier..You could set all the volume descriptors however 'Use this setting if creating an image from network files or when 'creating an image with a substantial amount of small files 'Only valid for Data images (ISO/Joliet not Audio discs) 'Maximum cache is currently limited to 4.2GB by FAT32 .CacheImage = (chkCacheImage.Value = vbChecked) 'Use Burn Proof/JustLink on this write? .SetBufferProtection (chkUseBurnProof.Value = vbChecked) 'wtpDataMode2_XA has been added for backward compatibility 'wtpDataMode1 is the standard for ISO9660 data disc. .WriteType = IIf((chkUseMode2XA.Value = vbChecked), wtpDataMode2_XA, wtpDataMode1) 'NOT VALID For DVD formats CD ONLY .TestWrite = (chkTestWrite.Value = vbChecked) 'Only write in test mode End With 'Start the disc writing process..this should always return True 'Finally - Write the disc.... If CDWriterPro1.WriteDisc() = False Then MsgBox "Disc Write could not be started.", vbCritical, App.Title End If End Sub Private Sub Form_Load() 'Display Version Me.Caption = "Sample1 CDWriterPro - Version " & CDWriterPro1.GetVersion() 'VERY IMPORTANT - Initialize the drives 'The control will not function properly without calling this function first 'Optiontally you can use ASPI for NT, but not recommended If CDWriterPro1.InitDrives(False) = False Then MsgBox "Drives Cannot be initialized...Contact support!" End If '*************** ENABLE LOGGING CODE ' This is how you enable logging if you need it ' 'Enable logging? ' If CDWriterPro1.SetLogging("C:\DVDTestlog.txt", True) = False Then ' MsgBox "Error enabling logging!" ' End If '*************** END LOGGING CODE 'Load the Drives LoadDriveCombo 'Set image List for directory tree Set tvwDirectories.ImageList = ImageList1 'Set image list for lisy view Set lvwImageFiles.SmallIcons = ImageList1 'Clear the ISO Image..reset event will fire to prepare the GUI Call CDWriterPro1.ClearISOImage 'Make sure the form is enabled Call EnableForm(True) End Sub Private Sub Form_Unload(Cancel As Integer) 'Don't Unload if we are writing Cancel = Not mblnUnloadOk End Sub Private Sub lvwImageFiles_AfterLabelEdit(Cancel As Integer, NewString As String) 'Validate the name with simple validation If ValidateISONames(NewString) = False Then Cancel = 1 Exit Sub End If 'Rename the item in the list 'the Item rename event will let us change the file list. 'If the name already exists...this will return False If CDWriterPro1.RenameISOFile(lvwImageFiles.SelectedItem.Key, NewString) = False Then MsgBox "File could not be renamed.", vbInformation + vbOKOnly, App.Title End If 'Update the image display Call UpdateImage End Sub Private Function ValidateISONames(strNewName As String) As Boolean Dim strFileName As String Dim strExt As String Dim intExtPos As Integer 'Default to false ValidateISONames = False 'Get the name and extension to validate the file or directory name. 'We have used very simple validation for this sample... 'see the ISO9660 specification for complete validation rules. 'Get the position of the '.' intExtPos = InStr(1, strNewName, ".", vbTextCompare) 'Do we have an extension? If intExtPos > 0 Then strFileName = Left$(strNewName, intExtPos) strExt = Mid$(strNewName, intExtPos) Else strFileName = strNewName End If 'Check for a zero length name If Len(strFileName) = 0 Then MsgBox "Item name cannot be blank.", vbInformation + vbOKOnly, App.Title Exit Function End If 'The file name should be validated here to ISO or Joliet standards 'ISO (Level1) - 8 character Filename + 3 extension 'ISO (Level2) - 31 character max including extension 'Joliet - 64 character max including extension 'Validate Joliet names If (Len(strNewName) > 64) And (CDWriterPro1.VolumeType = vtyISO9660_JOLIET) Then MsgBox "Item Name violates Joliet naming rules (64 Char Max).", vbInformation + vbOKOnly, App.Title Exit Function End If 'Validate ISO Level 1 name......MOST COMMON to all Operating systems If (CDWriterPro1.VolumeType = vtyISO9660_JOLIET) And (CDWriterPro1.ISOComplianceLevel = lvISO9660Level_1) Then If (Len(strFileName) > 8) Or (Len(strExt) > 3) Then MsgBox "Item Name violates ISO9660 Level 1 naming rules (8 + 3 Char Max).", vbInformation + vbOKOnly, App.Title Exit Function End If End If 'Validate ISO Level 2 name If (Len(strNewName) > 31) And (CDWriterPro1.VolumeType = vtyISO9660_JOLIET) And (CDWriterPro1.ISOComplianceLevel <> lvISO9660Level_1) Then MsgBox "Item Name violates ISO9660 Level 2 naming rules (31 Char Max).", vbInformation + vbOKOnly, App.Title Exit Function End If 'Else we passed the validation ValidateISONames = True End Function Private Sub lvwImageFiles_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 'Pop up menu If Button = vbRightButton Then 'Hide items mnuFileSep1.Visible = False 'Hide Directory name edit mnuFileRemoveDir.Visible = False mnuFileRenameDir.Visible = False mnuFileSep2.Visible = False mnuFileSaveImageAsISO.Visible = False mnuFileWriteDiscFromISO.Visible = False mnuFileSep3.Visible = False mnuFileExit.Visible = False 'Pop the menu PopupMenu mnuFile 'Show items mnuFileSep1.Visible = True mnuFileRemoveDir.Visible = True mnuFileRenameDir.Visible = True mnuFileSep2.Visible = True mnuFileSaveImageAsISO.Visible = True mnuFileWriteDiscFromISO.Visible = True mnuFileSep3.Visible = True mnuFileExit.Visible = True End If End Sub Private Sub mnuCDRecorderCloseTray_Click() Call CDWriterPro1.EjectLoad(True) End Sub Private Sub mnuCDRecorderDiscInfo_Click() 'Show disc information form - do modal from this function Call frmDiscInfo.ShowDiscInfo(CDWriterPro1, Me) End Sub Private Sub mnuCDRecorderEject_Click() Call CDWriterPro1.EjectLoad(False) End Sub Private Sub mnuCDRecorderEraseDisc_Click() 'Ersae the disc - Rewritable only Call frmErase.ShowErase(CDWriterPro1) End Sub Private Sub mnuCDRecorderImportPreviousSession_Click() 'Check for a valid Drive If mlngCurrentDrive = -1 Then MsgBox "A drive is not selected or does not exist.", vbInformation + vbOKOnly, App.Title Exit Sub End If 'Check for media loaded If CDWriterPro1.GetMediaType() = mtNotLoaded Then MsgBox "Please Insert a disc before continuing!", vbInformation, App.Title Exit Sub End If 'Display status sbrStatus.Panels(1).Text = "Importing Previous Session..." 'ONLY MODE1 ISO or Joliet Volumes can be imported 'Attempt to import the previous session If CDWriterPro1.ImportISOTrack(True) = False Then MsgBox "Previous Session could not be imported" & vbCrLf & "Only ISO/Joliet tracks (Mode1) can be imported.", vbCritical, App.Title Exit Sub End If 'Change Volume ID to new Volume Identifier txtVolIdentifier.Text = CDWriterPro1.VolumeIdentifier 'Expan the node If tvwDirectories.Nodes.Count > 0 Then tvwDirectories.Nodes(1).Expanded = True End If 'If we suceeded...Update image List Call UpdateImage End Sub Private Sub mnuFileClear_Click() 'Clear the ISO Image..reset event will fire to prepare the GUI Call CDWriterPro1.ClearISOImage End Sub Private Sub ResetImage() 'Clear File List Call lvwImageFiles.ListItems.Clear 'Clear the directory nodes Call tvwDirectories.Nodes.Clear 'Default the Volume Identifier to 'New Disc' CDWriterPro1.VolumeIdentifier = "New Disc" 'Add a root node for the root image directory Call tvwDirectories.Nodes.Add(, , "\", CDWriterPro1.VolumeIdentifier, "CD", "CD") txtVolIdentifier.Text = CDWriterPro1.VolumeIdentifier 'Recalc image size Call RecalcImageSize End Sub Private Sub mnuFileExit_Click() Unload Me End Sub Private Sub mnuFileRemoveDir_Click() Dim nodItem As Node Dim strKey As String Set nodItem = tvwDirectories.SelectedItem 'Check for an item If nodItem Is Nothing Then MsgBox "No Item Selected.", vbInformation + vbOKOnly, App.Title Exit Sub End If 'Get the key strKey = nodItem.Key 'Remove the item from the tree 'the Item removed event will let us change the list If CDWriterPro1.RemoveISOItem(strKey) = False Then MsgBox "Item could not be removed.", vbInformation + vbOKOnly, App.Title End If 'Update The image display Call UpdateImage End Sub Private Sub mnuFileRemoveFile_Click() Dim lstItem As ListItem Set lstItem = lvwImageFiles.SelectedItem 'Check for an item If lstItem Is Nothing Then MsgBox "No Item Selected.", vbInformation + vbOKOnly, App.Title Exit Sub End If 'Remove the item from the list 'the Item removed event will let us change the list If CDWriterPro1.RemoveISOItem(lstItem.Key) = False Then MsgBox "Item could not be removed.", vbInformation + vbOKOnly, App.Title End If 'Update The image display Call UpdateImage End Sub Private Sub mnuFileRenameDir_Click() Dim nodItem As Node Set nodItem = tvwDirectories.SelectedItem 'Check for an item If nodItem Is Nothing Then MsgBox "No Item Selected.", vbInformation + vbOKOnly, App.Title Exit Sub End If 'Let the user modify the name Call tvwDirectories.StartLabelEdit End Sub Private Sub mnuFileRenameFile_Click() Dim lstItem As ListItem Set lstItem = lvwImageFiles.SelectedItem 'Check for an item If lstItem Is Nothing Then MsgBox "No Item Selected.", vbInformation + vbOKOnly, App.Title Exit Sub End If 'Let the user modify the file Call lvwImageFiles.StartLabelEdit End Sub Private Sub mnuFileSaveImageAsISO_Click() Dim blnSuccess As Boolean On Error GoTo ErrorHandler 'Get filename for extracted Files CommonDialog1.DialogTitle = "Save as ISO File" CommonDialog1.FileName = "Test.iso" CommonDialog1.Filter = "ISO file (*.iso)|*.iso" CommonDialog1.Flags = cdlOFNNoValidate CommonDialog1.CancelError = True CommonDialog1.ShowOpen 'Disable Form Call EnableForm(False) With CDWriterPro1 'Also write Joliet Directory structures in addition to ISO structures .VolumeType = IIf((chkUseJoliet.Value = vbChecked), vtyISO9660_JOLIET, vtyISO9660_ONLY) .VolumeIdentifier = txtVolIdentifier.Text 'Were setting only the Volume Identifier..You could set all the volume descriptors however 'wtpDataMode2_XA has been added for backward compatibility 'wtpDataMode1 is the standard for ISO9660 data disc. .WriteType = IIf((chkUseMode2XA.Value = vbChecked), wtpDataMode2_XA, wtpDataMode1) End With 'Save the file as an ISO file blnSuccess = CDWriterPro1.CreateISOImageFile(CommonDialog1.FileName) 'Enable Form Call EnableForm(True) 'Check if successful If blnSuccess = True Then MsgBox "ISO File Created successfully!", vbOKOnly + vbInformation, App.Title Else MsgBox "Error creating ISO File.", vbCritical, App.Title End If 'Recalc Image size..show correct display Call RecalcImageSize Exit Sub ErrorHandler: 'No error on Cancel 'Enable Form Call EnableForm(True) End Sub Private Sub mnuFileWriteDiscFromISO_Click() Dim blnSuccess As Boolean On Error GoTo ErrorHandler 'Get filename for extracted Files CommonDialog1.DialogTitle = "Write ISO File" CommonDialog1.FileName = "Test.iso" CommonDialog1.Filter = "ISO file (*.iso)|*.iso" CommonDialog1.Flags = cdlOFNNoValidate CommonDialog1.CancelError = True CommonDialog1.ShowOpen 'Disable Form Call EnableForm(False) 'Set the properties of the write With CDWriterPro1 'You should make sure the image matches Mode1 or Mode2? 'wtpDataMode2_XA has been added for backward compatibility 'wtpDataMode1 is the standard for ISO9660 data disc. .WriteType = IIf((chkUseMode2XA.Value = vbChecked), wtpDataMode2_XA, wtpDataMode1) .CloseDisc = (chkFinalizeDisc.Value = vbChecked) 'Finalize 'Always Close session .CloseSession = True .TestWrite = (chkTestWrite.Value = vbChecked) 'Only write in test mode 'Use Burn Proof/JustLink on this write? .SetBufferProtection (chkUseBurnProof.Value = vbChecked) End With 'Save the file as an ISO file If CDWriterPro1.WriteISOImage(CommonDialog1.FileName) = False Then Call EnableForm(True) MsgBox "Error Writing ISO File.", vbCritical, App.Title End If Exit Sub ErrorHandler: 'No error on Cancel 'Enable Form Call EnableForm(True) End Sub Private Sub mnuHelpAbout_Click() ' CDWriterPro1.AboutBox End Sub Private Sub LoadDriveCombo() Dim intDrives As Integer 'Clear Drive Combo cboDevices.Clear 'Default to invalid drive mlngCurrentDrive = -1 'Get the ONLY recordable drives For intDrives = 0 To CDWriterPro1.GetDriveCount() - 1 'Is recorder - all drives are reported not just writers 'so we need to save the index so we know which drive to open If CDWriterPro1.IsDriveWriter(intDrives) = True Then cboDevices.AddItem CDWriterPro1.GetDriveLetter(intDrives) & ": " & CDWriterPro1.GetDriveVendor(intDrives) & " " & CDWriterPro1.GetDriveModel(intDrives) cboDevices.ItemData(cboDevices.NewIndex) = intDrives End If Next 'Set to first CDR If cboDevices.ListCount > 0 Then cboDevices.ListIndex = 0 Else MsgBox "There are no compatible CDR drives reported." & vbCrLf & _ "Some older CDR drives are not currently supported.", vbInformation + vbOKOnly, App.Title End If End Sub Private Sub cboDevices_Click() Dim lngDriveIndex As Long 'Set Drive Index from the Item Data lngDriveIndex = cboDevices.ItemData(cboDevices.ListIndex) 'Open the Drive for use..we have already screened out 'non writing drives when we loaded the drive combo If CDWriterPro1.OpenDrive(lngDriveIndex) = False Then mlngCurrentDrive = -1 Else mlngCurrentDrive = lngDriveIndex End If 'Load speeds for this drive LoadWriteSpeedCombo 'Set Burn Proof Check If CDWriterPro1.GetDriveCapabilityFlag(SupportsBurnProof) = True Then chkUseBurnProof.Enabled = True chkUseBurnProof.Value = vbChecked Else chkUseBurnProof.Enabled = False chkUseBurnProof.Value = vbUnchecked End If End Sub Private Sub cboWriteSpeed_Click() 'Check for speeds being available If cboWriteSpeed.Text <> "Default" Then 'Set Drive Speed CDWriterPro1.SetWriteSpeed cboWriteSpeed.ItemData(cboWriteSpeed.ListIndex) End If End Sub Private Sub LoadWriteSpeedCombo() Dim lngMaxWriteSpeedKBS As Long Dim lngSpeedKBS As Long Dim dblDisplaySpeed As Double Dim bUseDVDspeeds As Boolean Dim DiscType As eMediaType 'Get Max Write Speed in KB/S not as a multiplier. 'DVD and CD have different writing rates to calculate multipliers 'We must use the helper function to determine a multiplier easy for 'the user to understand 'What kind of speed multiplier do we need to show the user DiscType = CDWriterPro1.GetMediaType() If (DiscType = mtCD) Or (DiscType = mtCDRW) Or (DiscType = mtNotLoaded) Then 'This will be used to calc a multiplier based on KB/s bUseDVDspeeds = False Else bUseDVDspeeds = True End If 'Clear Combo cboWriteSpeed.Clear 'Get the MAX Write speed for the loaded media in kb/s lngMaxWriteSpeedKBS = CDWriterPro1.GetMaxWriteSpeed() 'If speed is not zero then If lngMaxWriteSpeedKBS > 0 Then 'Set our temp speed kbs to the max lngSpeedKBS = lngMaxWriteSpeedKBS 'DVD speeds or CD speeds for display If bUseDVDspeeds = True Then Do '1380 is the KB/S constant for DVD for 1X dblDisplaySpeed = CDbl(lngSpeedKBS) / 1380 'Calc a displayed Multiplier such as 2.4X for DVD cboWriteSpeed.AddItem Format(dblDisplaySpeed, "#.0") & "x" 'Save the Kb/s in the combo cboWriteSpeed.ItemData(cboWriteSpeed.NewIndex) = lngSpeedKBS 'For DVD we will increment in .5X levels (eg - 2.4X) lngSpeedKBS = lngSpeedKBS - 690 Loop While (lngSpeedKBS >= 1380) Else Do '176kbs is the KB/S constant for CD for 1X dblDisplaySpeed = CDbl(lngSpeedKBS) / 176 'Clean up displayed multiplier...some drives report speeds 'not in exact multiplies If (dblDisplaySpeed > 0) And (dblDisplaySpeed < 2) Then dblDisplaySpeed = 1 End If 'Calc a displayed Multiplier such as 16X for CD cboWriteSpeed.AddItem Format(dblDisplaySpeed, "#") & "x" 'Save the Kb/s in the combo cboWriteSpeed.ItemData(cboWriteSpeed.NewIndex) = lngSpeedKBS 'For CD we will decrement in 2X levels (eg - 8X) 'When we hit below 4x, then we decrement in 2X levels If lngSpeedKBS >= 1200 Then lngSpeedKBS = lngSpeedKBS - 704 Else lngSpeedKBS = lngSpeedKBS - 352 End If Loop While (lngSpeedKBS > 0) End If Else 'Some drives don't report speed cboWriteSpeed.AddItem "Default" End If 'Set to Max If cboWriteSpeed.ListCount > 0 Then cboWriteSpeed.ListIndex = 0 End If End Sub Private Function IsPathDirectory(strPath As String) As Boolean If (GetAttr(strPath) And vbDirectory) = vbDirectory Then IsPathDirectory = True Else IsPathDirectory = False End If End Function Private Sub LoadFileList(ByVal strCurrentDestPath As String) 'Set Wait pointer Me.MousePointer = vbHourglass 'Clear the List lvwImageFiles.ListItems.Clear 'Enumerate Files - makes it easy to update your list Call CDWriterPro1.EnumerateISOItems(strCurrentDestPath) 'Set Wait pointer Me.MousePointer = vbDefault End Sub Private Sub EnableForm(blnEnable As Boolean) 'Disable buttons and track view when recording mnuFile.Enabled = blnEnable mnuCDRecorder.Enabled = blnEnable mnuHelp.Enabled = blnEnable cboDevices.Enabled = blnEnable cboWriteSpeed.Enabled = blnEnable lvwImageFiles.Enabled = blnEnable tvwDirectories.Enabled = blnEnable cmdWriteDisc.Enabled = blnEnable chkCacheImage.Enabled = blnEnable chkFinalizeDisc.Enabled = blnEnable chkTestWrite.Enabled = blnEnable chkUseJoliet.Enabled = blnEnable txtVolIdentifier.Enabled = blnEnable chkUseMode2XA.Enabled = blnEnable 'Enable the burn Proof checkbox If (CDWriterPro1.GetDriveCapabilityFlag(SupportsBurnProof) = True) And (blnEnable = True) Then chkUseBurnProof.Enabled = True Else chkUseBurnProof.Enabled = False End If 'Only enable when recording cmdCancel.Enabled = Not blnEnable mblnUnloadOk = blnEnable 'Set Pointer If blnEnable = True Then Me.MousePointer = vbDefault Else Me.MousePointer = vbHourglass End If 'Let GUI catch up DoEvents End Sub Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) With imgSplitter picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20 End With picSplitter.Visible = True mblnMoving = True End Sub Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Dim sglPos As Single If mblnMoving = True Then sglPos = x + imgSplitter.Left If (sglPos < sglSplitLimit) Then picSplitter.Left = sglSplitLimit ElseIf (sglPos > Me.Width - sglSplitLimit) Then picSplitter.Left = Me.Width - sglSplitLimit Else picSplitter.Left = sglPos End If End If End Sub Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) SizeControls picSplitter.Left picSplitter.Visible = False mblnMoving = False End Sub Private Sub SizeControls(x As Single) On Error Resume Next 'Set the width for all items If x < 1500 Then x = 1500 If x > (Me.Width - 1500) Then x = Me.Width - 1500 tvwDirectories.Width = x tvwDirectories.Left = 20 imgSplitter.Left = x lvwImageFiles.Left = x + imgSplitter.Width lvwImageFiles.Width = Me.Width - (tvwDirectories.Width + imgSplitter.Width) - 100 lblImageFileTitle.Left = tvwDirectories.Left lblImageFileTitle.Width = Me.Width - 140 tvwDirectories.Top = lblImageFileTitle.Height + lblImageFileTitle.Top lvwImageFiles.Top = tvwDirectories.Top imgSplitter.Top = tvwDirectories.Top imgSplitter.Height = tvwDirectories.Height End Sub Private Sub Form_Resize() On Error Resume Next If Me.Width < 3000 Then Me.Width = 3000 SizeControls imgSplitter.Left End Sub Private Sub OLEDragDrop(Data As MSComctlLib.DataObject) Dim strItemToAdd As String Dim strSelectedImagePath As String Dim varItem As Variant Dim strTempPath As String Dim blnIsDirectory As Boolean 'Get only files as dropped data If Data.GetFormat(vbCFFiles) = False Then Exit Sub 'Set back Mouse pointer Me.MousePointer = vbHourglass 'Default to Blank strSelectedImagePath = "" 'Set the selected image Path If Not (tvwDirectories.SelectedItem Is Nothing) Then 'Dont include the '\' on the root so we don't have '\\' If tvwDirectories.SelectedItem.Key <> "\" Then strSelectedImagePath = tvwDirectories.SelectedItem.Key End If End If For Each varItem In Data.Files 'Set Temp Item strTempPath = CStr(varItem) 'Get the last item in the path strItemToAdd = GetLastPathItem(strTempPath) 'If is a Directory get recursive children files and directories blnIsDirectory = IsPathDirectory(strTempPath) 'If it is a directory then clone the directory to the image If blnIsDirectory = True Then Call CDWriterPro1.CloneDirectoryToISO(strSelectedImagePath & "\" & strItemToAdd, strTempPath & "\*.*") Else 'If just a file add it to the image Call CDWriterPro1.InsertISOItem(strSelectedImagePath & "\" & strItemToAdd, strTempPath) End If Next 'Update the display and load file list Call UpdateImage 'Set back Mouse pointer Me.MousePointer = vbDefault End Sub Private Sub UpdateImage() 'Update the image display 'Load file list If Not (tvwDirectories.SelectedItem Is Nothing) Then 'Enumerate the Selected folder Call LoadFileList(tvwDirectories.SelectedItem.Key) 'Expand selected folder tvwDirectories.SelectedItem.Expanded = True Else 'Enumerate the root list Call LoadFileList("\") 'Expand the root tvwDirectories.Nodes("\").Expanded = True End If 'Recalc the image size Call RecalcImageSize End Sub Private Sub RecalcImageSize() Dim lngSizeBlocks As Long Dim lngSizeBytes As Double 'Get blocks and convert to MB used in this image lngSizeBlocks = CDWriterPro1.GetISOVolumeSizeBlocks() lngSizeBytes = CDWriterPro1.ConvertBlocksToBytes(lngSizeBlocks, 1) 'Show the Volume Attributes sbrStatus.Panels(1).Text = "Data Image Size: " & Format((lngSizeBytes / 1000000), "##0.00") & " MB " sbrStatus.Panels(2).Text = "Files: " & CDWriterPro1.GetISOFileCount() sbrStatus.Panels(3).Text = "Directories: " & CDWriterPro1.GetISODirectoryCount() End Sub Private Sub tvwDirectories_AfterLabelEdit(Cancel As Integer, NewString As String) 'Validate the name with simple validation If ValidateISONames(NewString) = False Then Cancel = 1 Exit Sub End If 'Rename the item in the list 'the Item rename event will let us change the file list. 'If the name already exists...this will return False 'Pass the original destination path and the new directory name If CDWriterPro1.RenameISODirectory(tvwDirectories.SelectedItem.Key, NewString) = False Then MsgBox "Directory could not be renamed.", vbInformation + vbOKOnly, App.Title End If 'Update the image display Call UpdateImage End Sub Private Sub tvwDirectories_BeforeLabelEdit(Cancel As Integer) 'Dont let the user rename the root If tvwDirectories.SelectedItem.Key = "\" Then MsgBox "Root directory can not be renamed.", vbInformation + vbOKOnly, App.Title Cancel = 1 End If End Sub Private Sub tvwDirectories_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 'Pop up menu If Button = vbRightButton Then 'Hide items mnuFileSep1.Visible = False 'Hide Filename edit mnuFileRemoveFile.Visible = False mnuFileRenameFile.Visible = False mnuFileSep2.Visible = False mnuFileSaveImageAsISO.Visible = False mnuFileWriteDiscFromISO.Visible = False mnuFileSep3.Visible = False mnuFileExit.Visible = False 'Pop the menu PopupMenu mnuFile 'Show items mnuFileSep1.Visible = True mnuFileRemoveFile.Visible = True mnuFileRenameFile.Visible = True mnuFileSep2.Visible = True mnuFileSaveImageAsISO.Visible = True mnuFileWriteDiscFromISO.Visible = True mnuFileSep3.Visible = True mnuFileExit.Visible = True End If End Sub Private Sub tvwDirectories_NodeClick(ByVal Node As MSComctlLib.Node) 'Load the current directories files Call LoadFileList(Node.Key) End Sub Private Sub tvwDirectories_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single) 'Call generic drag and drop function Call OLEDragDrop(Data) End Sub Private Sub lvwImageFiles_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single) 'Call generic drag and drop function Call OLEDragDrop(Data) End Sub Private Function GetLastPathItem(strPath As String) As String Dim strTemp As String Dim intPos As Integer 'Find first path seperator in reverse intPos = InStrRev(strPath, "\") strTemp = Right(strPath, Len(strPath) - intPos) GetLastPathItem = strTemp End Function Private Sub txtVolIdentifier_Change() 'Set the root text to the new identifier tvwDirectories.Nodes("\").Text = txtVolIdentifier.Text End Sub